#light

module CGraph.AppGraph.Impl

open CGraph.AppGraph
open CGraph.DirectedGraph.Impl
open CGraph.DirectedGraph
open CGraph.Generic
open System.Collections.Generic;
open CGraph.Generic.Algorithms
open CGraph.DirectedGraph.Algorithms

type RequiredEdge( m_graph:IAppGraph, m_incoming:IServiceVertex, m_outgoing:IProviderVertex ) =
    inherit Edge( (m_graph :?> IDirectedGraph), (m_incoming :?> IVertex), (m_outgoing :?> IVertex))
    interface IRequiredEdge
    
type OptionalEdge( m_graph:IAppGraph, m_incoming:IServiceVertex, m_outgoing:IProviderVertex ) =
    inherit Edge( (m_graph :?> IDirectedGraph), (m_incoming :?> IVertex), (m_outgoing :?> IVertex))
    interface IOptionalEdge 

type ProviderEdge( m_graph:IAppGraph, m_incoming:IProviderVertex, m_outgoing:IServiceVertex ) =
    inherit Edge( (m_graph :?> IDirectedGraph), (m_incoming :?> IVertex), (m_outgoing :?> IVertex))
    interface IProviderEdge
    
type ServiceVertex( m_graph:IAppGraph, m_name:string ) =
    inherit Vertex( m_graph :?> IDirectedGraph )
    let mutable m_obj : obj option = None

    member this.SetObject item =
        m_obj <- Some item
        
    interface IServiceVertex with
        member this.Name with get() = m_name
        member this.Object 
            with get() =
                match m_obj with
                    | Some item -> item
                    | None -> null
                    
        
type ProviderVertex( m_graph:IAppGraph, m_init:InitializerCallback, m_name:string ) =
    inherit Vertex( m_graph :?> IDirectedGraph )
    interface IProviderVertex with
        member this.Name with get() = m_name
        member this.Initializer with get() = m_init
        
type AppVertexes( m_graph:IAppGraph) =
    inherit VertexCollection()
    
    member this.AddVertex (vert:IVertex) =
        (m_graph :?> DirectedGraph).AddVertex vert
        
    member this.CreateServiceVertex name =
        let retval = new ServiceVertex( m_graph, name )
        this.AddVertex retval 
        retval :> IServiceVertex
    member this.CreateProviderVertex init name =
        let retval = new ProviderVertex( m_graph, init, name )
        this.AddVertex retval
        retval :> IProviderVertex
        
type AppEdges( m_graph:IAppGraph, vertex_access:(unit -> seq<IVertex>) ) =
    inherit EdgeCollection( vertex_access )
    member this.AddEdge (edge:IEdge) =
        (m_graph :?> DirectedGraph).AddEdge edge
        
    member this.Require parent child =
        let retval = new RequiredEdge( m_graph, parent, child )
        this.AddEdge retval
        retval :> IRequiredEdge
        
    member this.Optional parent child =
        let retval = new OptionalEdge( m_graph, parent, child )
        this.AddEdge retval
        retval :> IOptionalEdge
        
    member this.Provides provider service =
        let retval = new ProviderEdge( m_graph, provider, service )
        this.AddEdge retval
        retval :> IProviderEdge
       
        
type AppGraph =
    inherit DirectedGraph
    new() as this = 
        {}
        then
            let vc = new AppVertexes (this :> IAppGraph)
            let ec = new AppEdges( (this :> IAppGraph), (fun() -> this.Vertexes :> seq<IVertex>) )
            this.Vertexes <- (vc :> VertexCollection)
            this.Edges <- (ec :> EdgeCollection)
            
    interface IAppGraph
    
    
type ServiceDictionary = IDictionary<string,obj>

type ServiceRecord(m_dict:ServiceDictionary,m_vertex:IProviderVertex) =
    interface IServiceRecord with
        member this.Item 
            // Returns null under two conditions.  First
            // if the vertex's provider hasn't explicitly
            // stated that it is optional or required
            // and second if it doesn't exist in the dictionary
            with get sname =
                let realVert = m_vertex :?> IVertex
                let finder (edge:IEdge) = 
                    match edge.IncomingVertex with
                        | :? IServiceVertex as service ->
                            if service.Name = sname then Some service else None
                        | _ -> None
                let item = realVert.IncomingEdges |> Seq.first finder
                match item with
                    | Some service -> 
                        let success,existing = m_dict.TryGetValue sname
                        if success then existing else null
                    | None -> null

            
type IProviderImpl =
    interface INamedObject
    abstract Init : IServiceInit -> InitializerResult array
    
type IGraphBuilder =
    abstract AddProviderImpl : IProviderImpl * (string seq) * (string seq) * (string seq) -> unit
            
type GraphBuilder(m_graph:IAppGraph) =
    let m_services = new Dictionary<string,IServiceVertex>()
    
    member this.GetOrCreate name =
        let success,svc = m_services.TryGetValue name
        if success = false 
            then
                let realGraph = m_graph :?> IDirectedGraph
                let vertexes = realGraph.Vertexes :?> AppVertexes
                let svc = vertexes.CreateServiceVertex name
                m_services.[name] <- svc
                svc
            else
                svc
        
    //Providers registered later will override registered
    //vertexes earlier.  This can be used to some benefit
    //as a provider can have a service it provides be an
    //optional dependency, and it can override it and replace
    //its place with something that delegates most calls
    //back to the original.  A given service may then have
    //several provide links.
    member this.AddProvider name init req opt provides =
        let realGraph = m_graph :?> IDirectedGraph
        let vertexes = realGraph.Vertexes :?> AppVertexes
        let edges = realGraph.Edges :?> AppEdges
        let provider = vertexes.CreateProviderVertex init name 
        req |> Seq.iter (fun (name:string) ->
            edges.Require (this.GetOrCreate name) provider |> ignore )
        opt |> Seq.iter (fun (name:string) ->
            edges.Optional (this.GetOrCreate name) provider |> ignore )
        provides |> Seq.iter (fun (name:string) ->
            edges.Provides provider (this.GetOrCreate name) |> ignore )
            
    interface IGraphBuilder with
        member this.AddProviderImpl ((impl:IProviderImpl) , (req:string seq) , (opt:string seq), (provides:string seq)) =
            let initFun = impl.Init
            this.AddProvider impl.Name initFun (req:string seq) (opt:string seq) (provides:string seq)
            
        

/// Called when a provider will not be called to initialize.
/// The sequence is the names of the services that failed.       
type FailedServiceHandler = IProviderVertex * string seq -> unit
            
/// Traverses the application graph passing in customized dictionaries
/// to each object as it is being created.  The dictionaries only
/// provide interface the provider has registered to need either
/// optionally or otherwise.
/// Traversal simply runs through the graph, from roots on building up results.
/// The graph is traversed in breadth-first order and thus traversal could
/// be trivially parallelized.
/// Should an optional service fail to startup, then it will not appear in
/// the dictionary passed into objects.  
/// Provider vertexes need to be accessed in a very certain order.
/// Basically you need to take the longest path from the root of the graph
/// to a given provider, sort by that length, and initialize based on the result.
let InitializeGraph (graph:IAppGraph) (failed:FailedServiceHandler option)=
    let realGraph = graph :?> IDirectedGraph
    let allServices = new Dictionary<string,obj>()
    let initList = new List<(unit->unit)>()
    let postInitList = new List<(unit->unit)>()
        
    /// Returns true of the vertex does not have
    /// a required edge incident to it.
    let NoRequiredEdgesFilter (vertex:IVertex) =
        let firstRequiredFilter (edge:IEdge) = 
            if (edge :? IRequiredEdge) then Some edge else None
        if (vertex :? IProviderVertex)
            then
                if vertex.InDegree = 0 then true else false
            else
                false
            
    let noRequiredRoots = new List<IVertex>((realGraph.Vertexes :> (IVertex seq)) |> Seq.filter NoRequiredEdgesFilter)
    noRequiredRoots.Sort( { new IComparer<IVertex> with
                                member this.Compare (prov1, prov2) = 
                                    let cntOptional (vert:IVertex) = 
                                        vert.IncomingEdges 
                                        |> Seq.filter (fun(edge) -> edge :? IOptionalEdge) 
                                        |> Seq.length
                                    let cnt1 = cntOptional prov1
                                    let cnt2 = cntOptional prov2
                                    cnt1 - cnt2 } )
    let depthLabeledVertexes = DepthLabel (noRequiredRoots :> IVertex seq)
    let depthProviders = depthLabeledVertexes.Keys 
                        |> Seq.filter (fun (vert) -> vert :? IProviderVertex ) 
                        |> Seq.map( fun(vert) -> vert :?> IProviderVertex )
                        
    let providerList = new List<IProviderVertex>( depthProviders );
    
    let providerSort = { new IComparer<IProviderVertex> with
                                member this.Compare (prov1, prov2) = 
                                    depthLabeledVertexes.[prov1 :?> IVertex] - depthLabeledVertexes.[prov2 :?> IVertex]
                       }
    
    providerList.Sort providerSort
        
    let initProvider provider =
        let record = ServiceRecord(allServices,provider) :> IServiceRecord
        let initCode = (provider.Initializer)
        let sinit = {new IServiceInit with
                        member this.ServiceCreated str = 
                            let success,obj = allServices.TryGetValue( str )
                            success
                            
                        member this.AddInitHook methHook =
                            initList.Add( (fun() ->
                                (methHook record) ) )
                                
                        member this.AddPostInitHook methHook = 
                            initList.Add methHook }
                                
        let initResult = initCode sinit
        for name,service in initResult do
            allServices.[name] <- service
            
    providerList |> Seq.iter initProvider
    
    for func in initList do func()
    for func in postInitList do func()
    allServices